)@VERSION = 0.029cmdColorM<&PuVi commandbutton}M__MU貁jp%P commandbuttonujEP2ҁTop = 4 Left = 255 Height = 23 Width = 25 FontBold = .T. FontItalic = .T. FontName = "Courier New" FontSize = 9 Caption = "I" ToolTipText = "Italic" Name = "cmdItalic"  rtfcontrols.t@t뚍Mq$l%P cmdItalictd t3j|  commandbutton%?@PjARDžMȉ commandbuttonUσjp%PMl%PMޙTop = 4 Left = 227 Height = 23 Width = 25 FontBold = .T. FontName = "Courier New" Caption = "B" ToolTipText = "Bold" Name = "cmdBold" 1詂]}Ep%PK rtfcontrols.@PjA裫p%P,[McmdBoldt{MbtoMUU0R<&P=p% commandbuttonP2ҁу commandbuttonUSVWڃ=p%Pp,Left = 172 Top = 4 Name = "Cbofontsize1" M} rtfcontrols.WDt@t렍Mi$ Cbofontsize1t^#t-comboboxU蒆U%?@PjAKDž soundplayergetmcierror^ PixelsClass2controlqbf.QMS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 Courier New, 1, 11, 9, 17, 12, 10, 5, 0 SV3c3k{tj3j moverlists T  PixelsT C % C  moverbox.bmp  T   moverbox.bmp  T mover list boxes T ClassZC ZT C % 74      5  ! containerHLUċMn moverlistsUF;o | F:%xU&G(#)T- UTHISENABLEDTHISFORMREFRESHClick,1cQ1s) soundplayerDTop = 0 Left = 36 Height = 23 Width = 23 Name = "tmrCheckMode" PROCEDURE Click THISFORM.LockScreen = .T. FOR i = 1 to THIS.Parent.lstSelected.ListCount THIS.Parent.lstSource.AddItem(THIS.Parent.lstSelected.List(i)) ENDFOR THIS.Parent.lstSelected.Clear THISFORM.LockScreen = .F. ENDPROC UQM5{apTop = 102 Left = 186 Height = 25 Width = 37 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = "<<" TabIndex = 6 ToolTipText = "Remove All Items" Name = "cmdRemoveAll" CȋU[WGDW׋"SMREH moverlists.'hM臜MP cmdRemoveAllhM빹 UItVMWji commandbutton׋MnlPM&l] commandbuttonuu^]SM3 moverlists.3_^[]ÍUMMEt:M^= cmdRemove%_^[]U3SMVEWEE commandbuttonMJTzMZT'M"Arial, 0, 10, 6, 16, 13, 14, 3, 0 NDPROC 8 * ELSE *  cbofontsize cmdExecuteQBFqbf.timer stopwatch datacheckercombobox, 10, 6, 16, 13, 14, 3, 0 n%day, date, and time controly , cSecDisplay) This.lblMinPixelsGFontBold = .F. Height = 25 Style = 2 Width = 217 Name = "fontbox" 12_) cbofontnameUJCAll textCC ii6%  Uw%C &FT-TaT- UTHISPARENT QBF_TABLEENABLED CMDEXECUTEQBFCMDCLEARFILTERTHISFORMREFRESHClick,1gARRBA1)i videoframe commandbuttonQPHk8 moverlists.xR{t# xR{ 8{ 8{$葹3ҋ checker.bmp checker.bmpmanages conflictsClass1gPROCEDURE Init DIMENSION x[1] =afont(x) FOR i = 1 TO ALEN(x) THIS.AddItem(x[i]) ENDFOR ENDPROC Image" nPos = O 66\%UWC%*.*PT UTHISFORM OLECOMMDLOGSHOWSAVEFILENAME TXTFILENAMEVALUESETFOCUSClick,1A1)6qbf containergetmcierror^ Pixels cmdAddAll\9P%^AV3ҋ 8{ comboboxvcxTUTHISADDITEM LIST1ombobox12_)Classntsunt WITH THISFORM.Controls[m.i].pages[m."Arial, 1, 10, 6, 16, 13, 15, 3, 0 clockPixels!F:\VFP\SAMPLES\CONTROLS\clock.bmp!F:\VFP\SAMPLES\CONTROLS\clock.bmp %Pe_U UTHISFORMRELEASEClick,11!)~PROCEDURE Click *!* Clear the filter that was set SET FILTER TO GO TOP THIS.enabled = .F. THISFORM.Refresh ENDPROC Class2control commandbutton2ۡX{JMVtF j3ҋ commandbuttonQA}>X{J X{B moverlists..}y}m}&Class4RTop = 0 Left = 66 Height = 25 Width = 25 Interval = 1000 Name = "tmrSWatch"  e%YnhU UTHISPARENT INCREMENTTimer,11&)Pixelsting" 7displays the font sizes available for a particular font Classbox= "Editing" Height = 32 Left = 0 Top = 0 Widtimer container videoframe< ##h(%U_(TSTATUS  MODE#%CstoppedX UCCMDTHISPARENTMCIALIASDOMCI PLAYVIDEOTimer,11A1)#PROCEDURE Timer cCmd = ("STATUS " + THIS.PARENT.MCIalias + " MODE") IF THIS.PARENT.doMCI(cCmd) = "stopped" THEN THIS.PARENT.playVideo ENDIF ENDPROC  %UQ C((CJCCUXITHISADDITEMInit,1QA1\)FTop = 96 Left = 120 Height = 23 Width = 23 Name = "tmrCheckMode"  videoframe.cmdAdd$}P{_^VW_  commandbuttonHBHHN1ontboxPY ht % 7comboboxSource.FontUnderline ENDCASE ENDPROC cbofontsize1QA1\comboboxE Destroy This.Visible = .F. ENDPROC PROCED tmrCheckModetimertimerWidth = 201 Height = 133 mcierror = 0 mcierrorstring = videofile = autoopen = .T. mcialias = autoplay = .T. autorepeat = .T. controlsource = Name = "videoframe" < ##h(%U_(TSTATUS  MODE#%CstoppedX UCCMDTHISPARENTMCIALIASDOMCI PLAYSOUNDTimer,11A1)#control tbreditingPixelscustom datachecker/Height = 15 Width = 23 Name = "datachecker" customPixelsting.gh all the controls on the page FOR m.k  cbofontname Left = 125 ToolTipText = "FontName" Top ="Arial, 0, 10, 6, 16, 13, 14, 3, 0 CASE cTask = 'INJArial, 0, 9, 5, 15, 12, 13, 3, 0 MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 Textbox EditboxgT  print_report# o&%C_SCREEN.ActivPixelsUT-UTHISVISIBLCProvides a form that allows users to choose the output of a report.e%RClassUse Paste to put them in Top = 71 Left = 186 Height = 25 Width = 37 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = "<" TabIndex = 5 ToolTipText = "Remove Selected Items" Name = "cmdRemove" !MJMU܍8`}uM stopwatch CASE CASE lcType $ "CM" lcValue = CHR(34)nsec nmin nhour ield, lcValue LOCAL lcType lcType =TPROCEDURE Click THISFORM.LockScreen = .T. nCnt = 1 DO WHILE nCnt <= THIS.Parent.lstSelected.ListCount IF THIS.Parent.lstSelected.Selected(nCnt) THIS.Parent.lstSource.AddItem(THIS.Parent.lstSelected.List(nCnt)) THIS.Parent.lstSelected.RemoveItem(nCnt) ELSE nCnt = nCnt + 1 ENDIF ENDDO THISFORM.LockScreen = .F. ENDPROC 3ҋME$tO %^vpUTCUTHIS TIMEFORMATDblClick,12@)4Class10PROCEDURE Click THISFORM.LockScreen = .T. FOR i = 1 to THIS.Parent.lstSource.ListCount THIS.Parent.lstSelected.AddItem(THIS.Parent.lstSource.List(i)) ENDFOR THIS.Parent.lstSource.Clear THISFORM.LockScreen = .F. ENDPROC u HdTop = 33 Left = 186 Height = 25 Width = 37 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = ">>" TabIndex = 4 ToolTipText = "Add All Items" Name = "cmdAddAll" tպ 8{=!UVWpMMQ oo_%&UwTa (R$CC  T-U THISFORM LOCKSCREENITHISPARENT LSTSELECTED LISTCOUNT LSTSOURCEADDITEMLISTCLEARClick,1AA1)otoolbarPROCEDURE Click THISFORM.LockScreen = .T. * The ListCount value changes whenever the RemoveItem method is called nCnt = 1 DO WHILE nCnt <= THIS.Parent.lstSource.ListCount IF THIS.Parent.lstSource.Selected(nCnt) THIS.Parent.lstSelected.AddItem(THIS.Parent.lstSource.List(nCnt)) THIS.Parent.lstSource.RemoveItem(nCnt) ELSE nCnt = nCnt + 1 ENDIF ENDDO THISFORM.LockScreen = .F. ENDPROC jjMjUTop = 2 Left = 186 Height = 25 Width = 37 FontBold = .T. FontName = "Courier New" FontSize = 11 Caption = ">" TabIndex = 3 ToolTipText = "Add Selected Items" Name = "cmdAdd" \tt3ÀyuD$PpAD commandbuttonXt 'XH4 moverlists.EP{;E~ 떋׋M7},D lstSelectedt:t58t0@?t׋(M0listbox=uҋ}3E=P{~tM0{listbox=6=`u U M moverlists.ame specified or control source specified!") 9 selected items to the Clipformem to the Clipboard.VCopie print_reportselected items and cop,OLEObject = C:\WINDOWS\SYSTEM\COMDLG32.OCX <ReGTop = 88 Left = 278 Height = 100 Width = 100 Name = "oleCommDlog" criptionWindows Explor print_report.n040904E4LCompa oleCommDlog?Str olecontrolse44VS_VERSION_INFO olecontrolwn... print_report.&FindMS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 MS Sans Serif, 1, 8, 6, 13, 11, 12, 2, 0 MS Sans Serif, 2, 8, 5, 13, 11, 11, 2, 0 MS Sans Serif, 4, 8, 5, 13, 11, 11, 2, 0  tbrediting soundplayer. tbrediting. tmrCheckMode lstSource THIS.videoFile IF EMPTY(cFileName) THEN Mlistbox = THIS.controlSource IF EMPTY(cControlSource) T stopwatch.AutoSize = .F. Top = 71 Left = 4 Height = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Caption = "\12, ; ALLTRIM(STR((VAL(SUBSTR(TIME(),1,2))-12)))+SUBSTR(TIME(),3,6),TIME()) ELSE This.Parent.txtTime.Value = TIME() ENDIF THIS.Parent.txtDate.Value = LONGDATE_LOC ENDPROC Timer1timertimer.FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 ColumnCount = 0 ColumnWidths = "" RowSourceType = 0 RowSource = "" ControlSource = "" DragIcon = grid\ DragMode = 0 Height = 132 Left = 0 MultiSelect = .T. NumberOfElements = 0 TabIndex = 1 Top = 0 Width = 169 Name = "lstSource" ATUS " + ctimerTAlignment = 2 BackStyle = 0 BorderStyle = 0 Value = (IIF(THIS.PARENT.TimeFormat = 0, IIF(VAL(SUBSTR(time(),1,2))>12, ALLT(STR((VAL(SUBSTR(time(),1,2))-12)))+SUBSTR(time(),3,6), time()),time())) Enabled = .F. Height = 21 Left = 184 Top = 5 Width = 57 DisabledForeColor = 0,0,0 DisabledBackColor = 255,255,255 Name = "txtTime" clock.txtTimetextboxtextboxclock. stopwatch.5Alignment = 2 BackColor = 255,255,0 BackStyle = 0 BorderStyle = 0 Value = (CDOW(date())+" "+CMONTH(date())+" "+ ALLT(STR(DAY(date())))+", "+ALLT(STR(YEAR(date())))) Enabled = .F. Height = 21 Left = 3 Top = 5 Width = 179 DisabledForeColor = 0,0,0 DisabledBackColor = 255,255,255 Name = "txtDate" txtDatetextboxtextbox timeformat label WINDOWS _RlabelENT Screen  stopwatch. lblSeparator1USERMiKPROCEDURE DblClick THIS.TimeFormat = ABS(THIS.TimeFormat - 1) ENDPROC ZWidth = 251 Height = 28 BackStyle = 0 BorderWidth = 0 timeformat = 0 Name = "clock"  containerPROCEDURE Click * Display file dialog thisform.oleCommDlog.ShowSave() IF thisform.oleCommDlog.FileName <> "*.*" THISFORM.txtFileName.Value = thisform.oleCommDlog.FileName THISFORM.txtFileName.SetFocus ENDIF ENDPROC (EmTop = 83 Left = 228 Height = 19 Width = 19 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Caption = "..." Enabled = .F. Name = "cmdSaveAs" &Go to... commandbutton&ToolbarcSta,PROCEDURE Click THISFORM.Release ENDPROC LTERSHOWSA print_report.GL%/Width = 409 Height = 132 BackStyle = 0 BorderWidth = 0 mousex = 0 mousey = 0 candropicon = DRAGMOVE.CUR nodropicon = NODROP01.CUR dragthreshold = 8 Name = "moverlists" 7 containerE;MjqMUQ΋x@ׅ9 cmdCancelFORM.txtFileName.SetFocus ENDIF ENDPROC  container container stopwatch`Width = 94 Height = 25 nsec = 0 nmin = 0 nhour = 0 elapsedseconds = 0 Name = "stopwatch" PROCEDURE start This.tmrSWatch.enabled = .t. ENDPROC PROCEDURE stop This.tmrSWatch.enabled = .f. ENDPROC PROCEDURE Reset This.nSec = 0 This.nMin = 0 This.nHour = 0 This.UpdateDisplay ENDPROC PROCEDURE updatedisplay cSecDisplay = ALLTRIM(STR(This.nSec)) cMinDisplay = ALLTRIM(STR(This.nMin)) cHourDisplay = ALLTRIM(STR(This.nHour)) This.lblSeconds.Caption = IIF(This.nSec < 10, "0" + cSecDisplay , cSecDisplay) This.lblMinutes.Caption = IIF(This.nMin < 10, "0" + cMinDisplay , cMinDisplay) This.lblHours.Caption = IIF(This.nHour < 10, "0" + cHourDisplay , cHourDisplay) ENDPROC PROCEDURE Init nMin = 0 nSec = 0 nHour = 0 ENDPROC timernsec nmin nhour elapsedseconds The time displayed in the stopwatch in elapsed seconds. *start *stop *Reset ,Property Description will appear here. *updatedisplay `Width = 94 Height = 25 nsec = 0 nmin = 0 nhour = 0 elapsedseconds = 0 Name = "stopwatch" PROCEDURE selectall LPARAMETERS oList LOCAL lnCnt FOR lnCnt = 1 to oList.ListCount oList.Selected(lnCnt) = .T. ENDFOR ENDPROC PROCEDURE Init This.lstSource.DragIcon = This.CanDropIcon This.lstSelected.DragIcon = This.CanDropIcon ENDPROC is returned. cRetString = space(80) nRetValue = mciSendStr commandbuttonORM.txtFileName.Value = thisform.oleCommDlonsec nmin nhour elapsedseconds The time displayed in the stopwatch in elapsed seconds. *start *stop *Reset ,Property Description will appear here. *updatedisplay nsmallestfont for scalable fonts, smallest allowable fontsize nlargestfont for scalable fonts, specifies the largest allowable fontsize *filllist UXITHISFontBold = .F. Height = 25 Style = 2 ToolTipText = "FontSize" Width = 44 nsmallestfont = 6 nlargestfont = 24 Name = "cbofontsize" orm.ControlCount IF oForm.Controls(i).Base commandbutton.ShowSave() IF thisform.oleCommDlog.FilePROCEDURE Timer THIS.Parent.nSec = THIS.Parent.nSec + 1 IF THIS.Parent.nSec = 60 THIS.Parent.nSec = 0 THIS.Parent.nMin = THIS.Parent.nMin + 1 ENDIF IF THIS.Parent.nMin = 60 THIS.Parent.nMin = 0 THIS.Parent.nHour = THIS.Parent.nHour + 1 ENDIF THIS.Parent.UpdateDisplay THIS.Parent.ElapsedSeconds = (THIS.Parent.nHour * 3600) + ; (THIS.Parent.nMin * 60) + ; (This.Parent.nSec) ENDPROC PROCEDURE start This.tmrSWatch.enabled = .t. ENDPROC PROCEDURE stop This.tmrSWatch.enabled = .f. ENDPROC PROCEDURE Reset This.nSec = 0 This.nMin = 0 This.nHour = 0 This.UpdateDisplay ENDPROC PROCEDURE updatedisplay cSecDisplay = ALLTRIM(STR(This.nSec)) cMinDisplay = ALLTRIM(STR(This.nMin)) cHourDisplay = ALLTRIM(STR(This.nHour)) This.lblSeconds.Caption = IIF(This.nSec < 10, "0" + cSecDisplay , cSecDisplay) This.lblMinutes.Caption = IIF(This.nMin < 10, "0" + cMinDisplay , cMinDisplay) This.lblHours.Caption = IIF(This.nHour < 10, "0" + cHourDisplay , cHourDisplay) ENDPROC PROCEDURE Init nMin = 0 nSec = 0 nHour = 0 ENDPROC PROCEDURE Click *!* In order to clear out all the controls with a controlSource, *!* we need to start a transaction and append a record (then when *!* we are done we'll rollback the transaction so the new record *!* doesn't get added to the table IF !EMPTY(THIS.Parent.QBF_table) THEN SELECT (THIS.Parent.QBF_table) ENDIF BEGIN TRANSACTION APPEND BLANK THIS.Enabled = .F. THIS.Parent.cmdExecuteQBF.Enabled = .T. THIS.Parent.cmdClearFilter.enabled = .F. THISFORM.Refresh ENDPROC  commandbuttontimer samples.vcx cbofontnameuG|U HSVp%PWy,< ࡱ> Root Entryy^OleObjectDataeAccessObjSiteData&\ChangedPropsM<+/IOO*.txtText (*.txt)|*.t\$828C4C820-401A-101B-A3C9-08002B2F49FB FileNameH*.txtFilterHText xtA(*.txt)|*.txtays the properties of thqbf)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 1 combobox PROCEDURE filllist LPARAMETERS cFontName THIS.Clear DIMENSION aSizes[1] =AFONT(aSizes, cFontname) IF aSizes[1] = -1 && The font is scalable lScalable = .T. nLen = THIS.nLargestFont nStart = THIS.nSmallestFont ELSE nLen = ALEN(aSizes) nStart = 1 lScalable = .F. ENDIF IF lScalable FOR i = nStart TO nLen THIS.AddItem(ALLTRIM(STR(i))) ENDFOR ELSE FOR i = nStart TO nLen THIS.AddItem(ALLTRIM(STR(aSizes[i]))) ENDFOR ENDIF ENDPROC ize THIS.chkBold.Value = oSTop = 42 Left = 261 Height = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Cancel = .T. Caption = "Cancel" Name = "cmdCancel"  Top = 14 Left = 261 Height = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Caption = "OK" Default = .T. Name = "cmdOK" PGREPORTOUTPUTVALUERELEASE mcierror Specifies the result of the last MCI command executed. mcierrorstring Stores the error string from the last MCI command executed. videofile Specifies the video file associated with the Video Frame. autoopen Specifies whether the video file specified should be automatically opened when the class is created. mcialias Specifies the alias for the video file when calling MCI commands. If empty, the name of the file is used. autoplay Specifies whether the video file should automatically play after opening. autorepeat If .T., video will continuously play controlsource Specifies the source of data to which an object is bound. *domci Executes a MCI command. *getmcierror Stores the last MCI error into properties of the class. *openvideo Opens the video file and shows it. *playvideo Plays the currently loaded video. *pausevideo Pauses a currently playing video. *showmcierror Displays the result of the last MCI command in a messagebox. *closevideo Closes the video file and releases all resources. *setposition Allows the user to set the position of the media file; Valid values are Start, End, or a number representing milliseconds. FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Value = 0 Height = 22 Left = 265 Style = 2 ToolTipText = "ForeColor and BackColor" Top = 5 Width = 69 Name = "cboColor" cboColor oo_%&UwTa (R$CC  T-U THISFORM LOCKSCREENITHISPARENT LSTSOURCE LISTCOUNT LSTSELECTEDADDITEMLISTCLEARClick,1AA1)o print_report.?(!9 cmdOK ?9  commandbuttone specified in the cReport property of this commandbuttonUi H b CkLAutoSize = .T. FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 BackStyle = 0 Caption = "File Name:" Height = 15 Left = 37 Top = 85 Width = 52 Name = "Label2" AutoSize = .T. FontBold = .T. FontName = "Arial" FontSize = 13 BackStyle = 0 Caption = ":" Height = 22 Left = 26 Top = 4 Width = 8 Name = "lblSeparator1" comboboxcomboboxBTop = 5 Left = 265 Height = 22 Width = 0 Name = "Separator2"  tbrediting. Separator2 separator separatorX ??jC%U1&%C_SCREEN.ActiveFormbO5T9AB HR* T -C FontUnderlineTEXTBOX-C FontUnderlineEDITBOX *#C FontUnderlineU OFORM ACTIVEFORMTHISPARENT NAPPLIESTO ACTIVECONTROL FONTUNDERLINEVALUESETALLInteractiveChange,1aAAqarr1A2 )? tbrediting. chkUnderlinedistinct_values_combo FPROCEDURE Click #DEFINE NO_REPORT_LOC "The report to print must either be specified in the cReport property of the form or passed in as a parameter." #DEFINE NO_FILENAME_LOC "You must enter a file name." DO CASE CASE EMPTY(THISFORM.cReport) =MESSAGEBOX(NO_REPORT_LOC) CASE THISFORM.opgReportOutput.value = 1 THISFORM.Release REPORT FORM (THISFORM.cReport) PREVIEW NOCONSOLE CASE THISFORM.opgReportOutput.value = 2 THISFORM.Release REPORT FORM (THISFORM.cReport) TO PRINTER NOCONSOLE CASE THISFORM.opgReportOutput.value = 3 IF EMPTY(THISFORM.txtFileName.value) THEN =MESSAGEBOX(NO_FILENAME_LOC) THISFORM.txtFileName.SetFocus ELSE THISFORM.Release REPORT FORM (THISFORM.cReport) ; TO FILE (THISFORM.txtFileName.value) ; ASCII NOCONSOLE ENDIF ENDCASE ENDPROC 11!) print_report.elease REPORT FORM (THISFORM.cReport) ;Label2_FILENAME_LOC) THISFORM.txtFileName.SetFocus label3 IF EMPTY(THISFORM.txtFileName.value) THEN labelO PRINTER NOCONSOLE CASE THISFORM.opgReportOutimercontrol0Width = 311 Height = 32 Name = "rtfcontrols" 럿FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Enabled = .F. Height = 23 Left = 95 Top = 81 Width = 128 Name = "txtFileName" THISFORM.Release REPORT FORM (THISFO print_report. =MESSAGEBOX(NO_REPORT_LOC) CASE THI txtFileNamet enter a file name." DO CASE CASE EMPTYcheckboxcheckboxlabelRESERVED7MalabelRESERVED5MY1PROCEDURE Timer THIS.Parent.Increment ENDPROC RTop = 2 Left = 52 Height = 25 Width = 25 Interval = 1000 Name = "tmrSWatch" OBJNAMEM)PROCEDURE Timer cCmd = ("STATUS " + THIS.PARENT.MCIalias + " MODE") IF THIS.PARENT.doMCI(cCmd) = "stopped" THEN THIS.PARENT.playSound ENDIF ENDPROC mcierror Specifies the result of the last MCI command executed. mcierrorstring Stores the error string from the last MCI command executed. autoopen Specifies whether the video file specified should be automatically opened when the class is created. mcialias Specifies the alias for the video file when calling MCI commands. If empty, the name of the file is used. autoplay Specifies whether the video file should automatically play after opening. autorepeat If .T., video will continuously play soundfile Specifies the sound file associated with the Sound Player. controlsource Specifies the source of data to which an object is bound. *domci Executes a MCI command. *getmcierror Stores the last MCI error into properties of the class. *showmcierror Displays the result of the last MCI command in a messagebox. *setposition Allows the user to set the position of the media file; Valid values are Start, End, or a number representing milliseconds. *opensound Opens the sound file. *pausesound Pauses the currently playing sound. *playsound Plays the loaded sound file. *closesound Closes the loaded sound file and releases it's resources. Width = 33 Height = 36 BorderWidth = 0 mcierror = 0 mcierrorstring = autoopen = .T. mcialias = autoplay = .T. autorepeat = .T. controlsource = Name = "soundplayer" PROCEDURE parsecondition LPARAMETERS cCondition, cControlSource LOCAL lcRetCondition, lcFieldName IF TYPE('cCondition') = 'C' cCondition = ALLTRIM(cCondition) ENDIF lcFieldName = SUBSTRC(cControlSource,(RATC(".",cControlSource)+1)) *!* NOTE: If you add a checkbox, radio button, or command group to *!* the form, this routine will need to be changed to handle that *!* specific datatype. IF !EMPTY(cCondition) THEN *!* If the type is Character or Memo, check to see if the *!* user has entered a complex condition (if so, take that *!* condition literally without any manipulation IF TYPE('cCondition')$ "CM" IF ("<" $ cCondition OR ; "==" $ cCondition OR ; "LIKE" $ cCondition OR ; "<>" $ cCondition OR ; "!=" $ cCondition OR ; "#" $ cCondition OR ; "=" $ cCondition OR ; ">" $ cCondition) lcRetCondition = lcFieldName + cCondition ENDIF ENDIF *!* If a complex condition wasn't found above (lcRetCondition will be empty) *!* Then we need to create the WHERE condition ourselves IF EMPTY(lcRetCondition) *!* The RATC() Functions figure out the column to compare based on the *!* controlSource of the control and any delimiters needed for the *!* datatype are added around the values (not all conditions are *!* assumed to be = when we construct them ourselves DO CASE CASE TYPE(cControlSource) $ "CM" lcRetCondition = lcFieldName + " = " + CHR(34) + cCondition + CHR(34) CASE TYPE(cControlSource) $ "DT" lcRetCondition = lcFieldName + " = {" + DTOC(cCondition) + "}" OTHERWISE lcRetCondition = lcFieldName + " = " + STR(cCondition) ENDCASE ENDIF ELSE lcRetCondition = "" ENDIF RETURN lcRetCondition ENDPROC  print_report.ommands are in effect.Compiled code for th>PROCEDURE optPreview.Click THISFORM.txtFileName.enabled = .F. THISFORM.cmdSaveAs.enabled = .F. ENDPROC PROCEDURE optPrinter.Click THISFORM.txtFileName.enabled = .F. THISFORM.cmdSaveAs.enabled = .F. ENDPROC PROCEDURE optFile.Click THISFORM.txtFileName.enabled = .T. THISFORM.cmdSaveAs.enabled = .T. ENDPROC erver.Error saving the OLE object.Error creating the OLEopgReportOutputey.Too many READ commands are in effect. optiongroupion file.Total label width exceeds allowed s optiongroupny characters in the report.Invalid expressi commandbutton container parsecondition LPARAMETERS cCondition, cContrClass textboxhe cReport property of this form." #DEFINE NO_FItextboxRE Click #DEFINE NO_REPORT_LOC "A report must beAutoSize = .T. FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 BackStyle = 1 Caption = " Report Output " Height = 15 Left = 20 Top = 7 Width = 75 Name = "lblReportOutput" ult = .T. Name = "cmdOK"  print_report.lblReportOutputlabelndbuttonlabel37 Top = 85 Width = 52 Name = "Label2"  tbrediting. stopwatch.TIMESTAMPN  tmrSWatchPLATFORMCtimertimernsec nmin nhour elapsedseconds The time displayed in the stopwatch in elapsed seconds. *start *stop *reset ,Property Description will appear here. *updatedisplay *increment increment the stopwatch display  containerF-thHtYF~u~ u 0<ltF"Arial, 1, 10, 6, 16, 13, 14, 3, 0  frmnotitlePixelsClass1form frmnotitleTop = 0 Left = 0 Height = 150 Width = 300 DoCreate = .T. BorderStyle = 1 Caption = "" Closable = .F. ControlBox = .F. MaxButton = .F. MinButton = .F. Movable = .F. AlwaysOnTop = .T. ZoomBox = .F. Name = "frmnotitle" form resizableminitialresize initialformheight initialformwidth addtoarray setsize loopthroughcontrols acontrolstats PixelsClass1custom resizable$initialresize Is this the first time the controls are being adjusted? initialformheight initialformwidth *adjustcontrols call from resize event of a form to adjust the placement and size of contained objects. *addtoarray *setsize *loopthroughcontrols *reset ^acontrolstats[1,5] oHeight = 19 Width = 27 initialresize = .T. initialformheight = 0 initialformwidth = 0 Name = "resizable" customPROCEDURE InteractiveChange IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control oForm.ActiveControl.FontUnderline = THIS.Value CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontUnderline', THIS.Value, 'TEXTBOX') oForm.SetAll('FontUnderline', THIS.Value, 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontUnderline', THIS.Value) ENDCASE ENDPROC Top = 5 Left = 234 Height = 22 Width = 26 FontName = "MS Sans Serif" FontSize = 8 FontUnderline = .T. Caption = "U" Value = .F. Style = 1 ToolTipText = "Underline" Name = "chkUnderline" Top = 5 Left = 209 Height = 22 Width = 26 FontItalic = .T. FontName = "MS Sans Serif" FontSize = 8 Caption = "I" Value = .F. Style = 1 ToolTipText = "Italic" Name = "chkItalic"  chkItaliccheckboxdFontName = "MS Sans Serif" FontSize = 8 Height = 23 Width = 106 Name = "distinct_values_combo" File Name:" Height Cqbf_table Specifies the table to query against. *parsecondition  commandbuttoncheckbox tbrediting.UFontBold = .F. FontName = "MS Sans Serif" FontSize = 8 ColumnCount = 0 ColumnWidths = "" RowSourceType = 0 RowSource = "" ControlSource = "" DragIcon = grid\ DragMode = 0 FirstElement = 1 Height = 132 Left = 240 MoverBars = .T. MultiSelect = .T. NumberOfElements = 0 TabIndex = 2 Top = 0 Width = 169 Name = "lstSelected" ׋MW&j3j蚉 rtfcontrols.0H1Ӆuҍx4%? container@ t~t}t||Top = 4 Left = 283 Height = 23 Width = 25 Caption = "C" ToolTipText = "Color" ForeColor = 255,0,0 Name = "cmdColor" 8됍M $l%Pp%PM裖 rtfcontrolsMuuu )_^[] &PVN 3%~8UiCColors CSet ForeColor... CSet BackColor...TUTHISADDITEM LISTINDEX&%C_SCREEN.ActiveFormbOET9TQB Hbt zB  TC% H N&%CoControl.ForeColorbNT J*%CoControl.ItemForeColorbNFT  'C ForeColorTEXTBOX 'C ForeColorEDITBOX  C ForeColor  t T C% p H)l 1%CoForm.ActiveControl.BackColorbNT  5%C!oForm.ActiveControl.ItemBackColorbNT  ;'C BackColor TEXTBOX 'C BackColor EDITBOX  lC BackColor TUOFORM ACTIVEFORMOCONTROL ACTIVECONTROLTHISVALUE NFORECOLORTHISFORM NAPPLIESTO FORECOLOR ITEMFORECOLORSETALL NBACKCOLOR BACKCOLOR ITEMBACKCOLORInit,InteractiveChange1f3aAAAAA!AaAAAqqBAAB!A1Q1AAAqqBAAA3 5 )L 33%U(&%C_SCREEN.ActiveFormbO5T9AB HR! T *C FontItalicTEXTBOX*C FontItalicEDITBOX ! C FontItalicU OFORM ACTIVEFORMTHISPARENT NAPPLIESTO ACTIVECONTROL FONTITALICVALUESETALLInteractiveChange,1aAAqarrB2)3 PROCEDURE InteractiveChange IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control oForm.ActiveControl.FontItalic = THIS.Value CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontItalic', THIS.Value, 'TEXTBOX') oForm.SetAll('FontItalic', THIS.Value, 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontItalic', THIS.Value) ENDCASE ENDPROC Top = 5 Left = 184 Height = 22 Width = 26 FontBold = .T. FontName = "MS Sans Serif" FontSize = 8 Caption = "B" Value = .F. Style = 1 ToolTipText = "Bold" Name = "chkBold" comboboxILENAME_LOC) THISFORM.txtFileName.SetFocus !PROCEDURE handlerecord *---------------------------------------------------------------* * This method is called from the CheckConflicts method and the * VerifyEachChange method. It loops through each field in the * current record and compares the current value with the value * stored in the table. If a value of 1 is passed to this method, * the method also compares the current value with the value in * the field before user made any edits. * * RETURNS NUMERIC VALUES: * 0 -- No Change Made to the Current Value * 1 -- Successfully Made User-Specified Change * 2 -- Unable to Make User-Specifed Change *---------------------------------------------------------------* LPARAMETERS lnScope *--Valid values for lnScope: * 0 - Only manage conflicts && default * 1 - Also prompt for changed values * Verify parameter IF TYPE("m.lnScope") != "N" m.lnScope = 0 ENDIF IF !BETWEEN(m.lnScope, 0, 1) #define WINDMSG_LOC "Invalid value passed to conflictmanager.handlerecord" WAIT WINDOW WINDMSG_LOC ENDIF * Declare constants & variables #define CR_LOC CHR(13) #define SAVE_LOC "Do you want to overwrite the current value with your change?" + CR_LOC + "(Choose 'Cancel' to restore the original value.)" #define CONFLICT_LOC "Data Conflict" #define VERIFY_LOC "Verify Changes" #define ORG_LOC "Original Value: " #define CUR_LOC "Current Value: " #define CHG_LOC "Your change: " #define MEMO_LOC " is a Memo field." #define FIELD_LOC "Field: " #define RECORD_LOC "Record Number: " #define VALCHG1_LOC "A value has been changed by another user." #define VALCHG2_LOC "A value has been changed." LOCAL lnChoice, lnField, lcField, luOldVal, luCurVal, luField, llMadeChange, llSuccess m.llMadeChange = .F. m.llSuccess = .T. * refresh current record in views before checking for conflicts IF CURSORGETPROP('SourceType') != 3 && not a local table =REFRESH() ENDIF * Check each field in the record for conflict or value change FOR m.lnField = 1 to FCOUNT() m.lnChoice = 0 m.lcField = FIELD(m.lnField) IF TYPE(m.lcField) = "G" LOOP && Can't check general fields ENDIF m.luOldVal = OLDVAL(m.lcField) m.luCurVal = CURVAL(m.lcField) DO CASE * -----< check for conflicts only >-------- CASE m.lnScope = 0 IF m.luOldVal != m.luCurVal m.llMadeChange = .T. m.lnChoice = MESSAGEBOX(VALCHG1_LOC + CR_LOC + FIELD_LOC + lcField + CR_LOC + ; RECORD_LOC + ALLTRIM(STR(RECNO())) + ; IIF(TYPE("m.lcField") != "M", CR_LOC + CR_LOC + ORG_LOC + THIS.String(m.luOldVal) + ; CR_LOC + CUR_LOC + THIS.String(m.luCurVal) + ; CR_LOC + CHG_LOC + THIS.String(EVAL(m.lcField)), CR_LOC + CR_LOC + m.lcField + MEMO_LOC) + ; CR_LOC + CR_LOC + SAVE_LOC, + 3+48+0, CONFLICT_LOC) ENDIF * -----< check for conflicts and verify all changes >-------- CASE m.lnScope = 1 && Verify all changes m.luField = EVAL(m.lcField) IF m.luOldVal != m.luField OR m.luCurVal != m.luField m.llMadeChange = .T. m.lnChoice = MESSAGEBOX(VALCHG2_LOC + CR_LOC + FIELD_LOC + m.lcField + CR_LOC + ; RECORD_LOC + ALLTRIM(STR(RECNO())) + ; IIF(TYPE("m.lcField") != "M", CR_LOC + CR_LOC + ORG_LOC + THIS.String(m.luOldVal) + ; CR_LOC + CUR_LOC + THIS.String(m.luCurVal) + ; CR_LOC + CHG_LOC + THIS.String(EVAL(m.lcField)), CR_LOC + CR_LOC + m.lcField + MEMO_LOC) + ; CR_LOC + CR_LOC + SAVE_LOC, + 3+48+0, VERIFY_LOC) ENDIF ENDCASE DO CASE CASE m.lnChoice = 7 && No, don't save changes REPLACE (m.lcField) WITH m.luCurVal CASE m.lnChoice = 2 && Cancel, restore original value REPLACE (m.lcField) WITH m.luOldVal ENDCASE ENDFOR IF m.llMadeChange m.llSuccess = TABLEUPDATE(.F., .T.) RETURN IIF(m.llSuccess, 1, 2) ELSE RETURN 0 ENDIF ENDPROC PROCEDURE string *---------------------------------------------------------------* * This method is called from the HandleRecord method. It * returns the character equivalent of the value passed in as a * parameter. If a memo field is passed in, a notice to this * effect is returned rather than the value in the memo field so * that potentially large amounts of text aren't displayed in the * messagebox. *---------------------------------------------------------------* LPARAMETERS luValue m.uType = TYPE('m.luValue') DO CASE CASE m.uType = 'C' RETURN ALLTRIM(m.luValue) CASE INLIST(m.uType, 'N', 'Y') RETURN ALLTRIM(STR(m.luValue)) CASE m.uType = 'D' RETURN DTOC(m.luValue) CASE m.uType = 'T' RETURN TTOC('m.luValue') CASE m.uType = 'L' RETURN IIF(m.luValue, '.T.', '.F.') CASE uType = 'M' RETURN 'Memo field' ENDCASE ENDPROC PROCEDURE verifychanges *---------------------------------------------------------------* * If any changes have been made to the table or record, prompt the * user to save the changes. If the user says 'yes,' all changes * are saved. Any changes made to the data by other users after * this user made the change and before the change was committed * will be lost. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made All User Changes * 2 -- Unable to Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* * Declare constants & variables #define SAVECHG_LOC 'Do you want to save your changes?' #define SAVECHG2_LOC 'Save Changes' #define NOBUFF_LOC2 'Data buffering is not enabled.' LOCAL lnChoice, llMadeChange, lnSuccess m.llMadeChange = .F. m.lnSuccess = 0 * If the user has changed anything, prompt to save or discard changes DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) m.llMadeChange = .T. ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering IF GETNEXTMODIFIED(0) > 0 m.llMadeChange = .T. ENDIF OTHERWISE WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE IF m.llMadeChange m.lnChoice = MESSAGEBOX(SAVECHG_LOC, 4+32, SAVECHG2_LOC) IF m.lnChoice = 6 && Yes m.lnSuccess = IIF(TABLEUPDATE(.T.,.T.), 1, 2) ELSE =TABLEREVERT(.T.) ENDIF ENDIF RETURN m.lnSuccess ENDPROC PROCEDURE verifyeachchange *-------------------------------------------------------------------- * If any changes have been made to the table or record, for each * change, display the old value and the new value, prompting the * user to save or discard the change. Conflict management is also * included in the HandleRecord method. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made User-Specified Changes * 2 -- Unable to Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* #define NOBUFF_LOC3 'Data buffering is not enabled.' LOCAL lnSuccess, lnRec m.lnSuccess = 0 DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) && Data has changed m.lnSuccess = THIS.HandleRecord(1) ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering m.lnRec = GETNEXTMODIFIED(0) DO WHILE m.lnRec > 0 GO m.lnRec m.lnSuccess = IIF(m.lnSuccess != 2, THIS.HandleRecord(1), 2) m.lnRec = GETNEXTMODIFIED(m.lnRec) ENDDO OTHERWISE && No Buffering WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE RETURN m.lnSuccess ENDPROC PROCEDURE checkconflicts *---------------------------------------------------------------* * Checks to see whether another user has changed the value * stored in a table. If so, calls HandleRecord to display * the new value and allow the user to decide what to do. * * RETURNS NUMERIC VALUES: * 0 -- No Changes Made to the Current Values * 1 -- Successfully Made User-Specified Changes * 2 -- Unable to Make Write One or More User-Specifed Changes to Table *---------------------------------------------------------------* #define NOBUFF1_LOC 'Data buffering is not enabled.' LOCAL lnSuccess, llnRec m.lnSuccess = 0 DO CASE CASE INLIST(CURSORGETPROP('Buffering'), 2,3) && Row Buffering IF '2' $ GETFLDSTATE(-1) && Data has changed m.lnSuccess = THIS.HandleRecord(0) ENDIF CASE INLIST(CURSORGETPROP('Buffering'), 4,5) && Table Buffering m.llnRec = GETNEXTMODIFIED(0) DO WHILE m.llnRec > 0 GO m.llnRec m.lnSuccess = IIF(m.lnSuccess != 2, THIS.HandleRecord(0), 2) m.llnRec = GETNEXTMODIFIED(m.llnRec) ENDDO OTHERWISE && no buffering WAIT WINDOW NOBUFF_LOC NOWAIT ENDCASE RETURN m.lnSuccess ENDPROC Width = 92 Height = 27 BackStyle = 0 BorderWidth = 0 nsec = 0 nmin = 0 nhour = 0 elapsedseconds = 0 Name = "stopwatch" u u tN uN~믋*䊇BFB tchkBoldnArial, 0, 9, 5, 15, 12, 13, 3, 0 Courier New, 1, 9, 7, 16, 12, 8, 4, 0 Courier New, 3, 9, 7, 16, 12, 10, 4, 0 \EjFWidth = 80 Height = 97 BorderWidth = 0 qbf_table = Name = "qbf" ontrolSource,(RATC(".",cControlSource)+1)) *!*  commandbuttoncheckboxcheckboxBTop = 5 Left = 184 Height = 22 Width = 0 Name = "Separator1"  tbrediting. Separator1 separator separator m%( sU%T-T-UTHISFORM TXTFILENAMEENABLED CMDSAVEAS%T-T-UTHISFORM TXTFILENAMEENABLED CMDSAVEAS%TaTaUTHISFORM TXTFILENAMEENABLED CMDSAVEASoptPreview.Click,optPrinter.Click optFile.Click1221`3 )Pixels(!9 %C_FontName = "MS Sans Serif" FontSize = 8 Height = 22 Left = 135 Top = 5 Name = "cboSizes"  tbrediting.cboSizes rtfcontrolsuu :U4SUVMW3u containerP33 UDSVW&PUP6jEPWu 3_^[] `jA]$Classt"jSW؅u3C %Pc(tFPixels7CtjAU _jEPWlt H3 PROCEDURE adjustcontrols IF THIS.InitialResize THIS.LoopThroughControls("INITIALIZE_AND_ADJUST") THIS.InitialResize = .F. ELSE THIS.LoopThroughControls("ADJUST") ENDIF ENDPROC PROCEDURE addtoarray LPARAMETERS oControl nLen = ALEN(THIS.aControlStats,1) THIS.aControlStats[nLen,1] = oControl.Top / THIS.InitialFormHeight THIS.aControlStats[nLen,2] = oControl.Left / THIS.InitialFormWidth THIS.aControlStats[nLen,3] = oControl.Height / THIS.InitialFormHeight THIS.aControlStats[nLen,4] = oControl.Width / THIS.InitialFormWidth THIS.aControlStats[nLen,5] = IIF(TYPE("oControl.FontSize") = 'U', 0, oControl.FontSize) DIMENSION THIS.aControlStats[nLen+1, 5] ENDPROC PROCEDURE setsize LPARAMETERS oControl, nPos oControl.Top = THISFORM.Height * THIS.aControlStats[nPos,1] oControl.Left = THISFORM.Width * THIS.aControlStats[nPos,2] oControl.Width = THISFORM.Width * THIS.aControlStats[nPos,4] IF !oControl.Baseclass $ "Textbox Spinner" oControl.Height = THISFORM.Height * THIS.aControlStats[nPos,3] ENDIF *IF oControl.Baseclass = "Commandbutton" * IF TXTWIDTH(oControl.caption) > oControl.width * oControl.FontSize = 8 * ELSE * oControl.FontSize = 10 * ENDIF *ENDIF ENDPROC PROCEDURE loopthroughcontrols LPARAMETERS cTask * Valid parameters for cTask are 'Initialize_And_Adjust' and 'Adjust' cTask = UPPER(cTask) nOldDecimal = SET("DECIMAL") SET DECIMAL TO 4 #define BASE_CLASS "Commandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe Image Spinner" nPos = 0 THISFORM.LockScreen = .T. FOR m.i = 1 TO THISFORM.ControlCount oControl = THISFORM.Controls[m.i] IF oControl.Baseclass$BASE_CLASS nPos = nPos + 1 DO CASE CASE cTask = 'INITIALIZE_AND_ADJUST' THIS.AddToArray(oControl) THIS.SetSize(oControl, nPos) CASE cTask = 'ADJUST' THIS.SetSize(oControl, nPos) ENDCASE ENDIF *A pageframe can contain only pages IF THISFORM.Controls[m.i].Baseclass$"Pageframe" *Loop through each page of the pageframe FOR m.j = 1 TO THISFORM.Controls[m.i].PageCount WITH THISFORM.Controls[m.i].pages[m.j] *loop through all the controls on the page FOR m.k = 1 TO .ControlCount IF .Controls[m.k].Baseclass$BASE_CLASS nPos = nPos + 1 DO CASE CASE cTask = 'INITIALIZE_AND_ADJUST' THIS.AddToArray(.Controls[m.k]) THIS.SetSize(.Controls[m.k], nPos) CASE cTask = 'ADJUST' THIS.SetSize(.Controls[m.k], nPos) ENDCASE ENDIF ENDFOR ENDWITH ENDFOR ENDIF ENDFOR THISFORM.LockScreen = .F. SET DECIMAL TO nOldDecimal ENDPROC PROCEDURE Init THIS.InitialFormHeight = THISFORM.Height THIS.InitialFormWidth = THISFORM.Width ENDPROC PROCEDURE reset THIS.InitialResize = .T. DIMENSION THIS.aControlStats[1,5] ENDPROC Q(MQM輶hPROCEDURE Init #DEFINE REPORT_NOT_FOUND_LOC "The report file '" + THISFORM.cReport + ; "' does not exist." + CHR(13) + CHR(13) + ; "You must specify a valid report file to print in the cReport property of the form or passed in as a parameter." #DEFINE NO_REPORT_LOC "The report to print must either be specified in the cReport property of the form or passed in as a parameter." LPARAMETERS cRepName *!* If no parameters are passed in, the variables are automatically *!* set to a logical .F. value. IF TYPE("cRepName") = "C" THEN *!* If a parameter is passed in, assume it is the report *!* name and set the cReport property of the form to it. THISFORM.cReport = cRepName ENDIF IF EMPTY(THISFORM.cReport) THEN MESSAGEBOX(NO_REPORT_LOC) RETURN .F. ENDIF IF !FILE(THISFORM.cReport) THEN MESSAGEBOX(REPORT_NOT_FOUND_LOC) RETURN .F. ENDIF ENDPROC e error in GET statement.Command contains unrecognized AutoSize = .F. Top = 3 Left = 4 Height = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Caption = "\ -1 DO CASE CASE THISFORM.nAppliesTo = 1 && current control IF TYPE("oControl.ForeColor") = "N" oControl.ForeColor = nForeColor ELSE IF TYPE("oControl.ItemForeColor") = "N" oControl.ItemForeColor = nForeColor ENDIF ENDIF CASE THISFORM.nAppliesTo = 2 && text and edit boxes oForm.SetAll('ForeColor', nForeColor, 'TEXTBOX') oForm.SetAll('ForeColor', nForeColor, 'EDITBOX') CASE THISFORM.nAppliesTo = 3 && All controls oForm.SetAll('ForeColor', nForeColor) ENDCASE ENDIF CASE This.Value = 3 && Get BackColor nBackColor = GETCOLOR() IF nBackColor > -1 DO CASE CASE THISFORM.nAppliesTo = 1 && current control IF TYPE("oForm.ActiveControl.BackColor") = "N" oForm.ActiveControl.BackColor = nBackColor ELSE IF TYPE("oForm.ActiveControl.ItemBackColor") = "N" oForm.ActiveControl.ItemBackColor = nBackColor ENDIF ENDIF CASE THISFORM.nAppliesTo = 2 && text and edit boxes oForm.SetAll('BackColor', nBackColor, 'TEXTBOX') oForm.SetAll('BackColor', nBackColor, 'EDITBOX') CASE THISFORM.nAppliesTo = 3 && All controls oForm.SetAll('BackColor', nBackColor) ENDCASE ENDIF ENDCASE THIS.Value = 1 ENDPROC  3%]uU  %C cConditionbCCTCTCC.%C %C cConditionbCMm%< == LIKE <> != # = > T%C H7 CbCMp$T = C" C"  CbDT T = {C*}2T = CZ T BU CCONDITIONCCONTROLSOURCELCRETCONDITION LCFIELDNAMEparsecondition,1AAAQAQAAA1) (%/rNU>Tc%C7USE IN &cCursor UCCURSORTHISNAME\%C U%. jC^The table alias must be specified in the controlSource property, in the format 'alias.column'.xQ$TCC.*TCCC.THTSELECT DISTINCT  FROM  INTO CURSOR cTUTHIS CONTROLSOURCECALIASCCOLUMN ROWSOURCETYPECSQLNAME ROWSOURCEDestroy,Init1Q1A23aAAA2\w)~ eet%U%CcRepNamebC3T%CyCmThe report to print must either be specified in the cReport property of the form or passed in as a parameter.xB-%C0 CThe report file '' does not exist.C C nYou must specify a valid report file to print in the cReport property of the form or passed in as a parameter.xB-UCREPNAMETHISFORMCREPORTInit,1wA"qA2q qA5u)e %` oUTa T+%C$CC  C TT-U THISFORM LOCKSCREENNCNTTHISPARENT LSTSELECTED LISTCOUNTSELECTED LSTSOURCEADDITEMLIST REMOVEITEMClick,1AqAA1I) >%3 UC(<TaUOLISTLNCNT LISTCOUNTSELECTED/TTUTHIS LSTSOURCEDRAGICON CANDROPICON LSTSELECTED selectall,Init1qqAA2aa2{)D ++g$%U"&%C_SCREEN.ActiveFormbO5T9AB HR T (CFontBoldTEXTBOX(CFontBoldEDITBOX CFontBoldU OFORM ACTIVEFORMTHISPARENT NAPPLIESTO ACTIVECONTROLFONTBOLDVALUESETALLInteractiveChange,1aAAqarrA2)+ tbrediting.PROCEDURE KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl IF nKeyCode = 63 AND nShiftAltCtrl = 1 THIS.Parent.SelectAll(THIS) ENDIF ENDPROC PROCEDURE MouseMove LPARAMETERS nButton, nShift, nXCoord, nYCoord IF nButton = 1 && Left Mouse IF ABS(nXCoord - THIS.Parent.MouseX) > THIS.Parent.DragThreshold OR ; ABS(nYCoord - THIS.Parent.MouseY) > THIS.Parent.DragThreshold THIS.Drag ENDIF ENDIF ENDPROC PROCEDURE MouseDown LPARAMETERS nButton, nShift, nXCoord, nYCoord THIS.Parent.MouseX = nXCoord THIS.Parent.MouseY = nYCoord ENDPROC PROCEDURE DragDrop LPARAMETERS oSource, nXCoord, nYCoord IF oSource.Name != THIS.Name THIS.Parent.cmdAdd.Click ENDIF ENDPROC PROCEDURE DblClick THIS.Parent.lstSource.AddItem(This.List(This.ListIndex)) This.RemoveItem(This.ListIndex) ENDPROC PROCEDURE DragOver LPARAMETERS oSource, nXCoord, nYCoord, nState DO CASE CASE nState = 0 && Enter oSource.DragIcon = THIS.Parent.CanDropIcon CASE nState = 1 && Leave oSource.DragIcon = THIS.Parent.NoDropIcon ENDCASE ENDPROC {t3;t %` oUTa T+%C$CC  C TT-U THISFORM LOCKSCREENNCNTTHISPARENT LSTSOURCE LISTCOUNTSELECTED LSTSELECTEDADDITEMLIST REMOVEITEMClick,1AqAA1) .%)H8U%dMTCCCC^\g #CCCCC^\g ZCC^\C^6TC^>TCC$ CC$! CCCC$%Z, CCCC$iZUTHISPARENT TIMEFORMATTXTTIMEVALUETXTDATETimer,1tQA2))MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 %PROCEDURE KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl IF nKeyCode = 63 AND nShiftAltCtrl = 1 THIS.Parent.SelectAll(THIS) ENDIF ENDPROC PROCEDURE MouseMove LPARAMETERS nButton, nShift, nXCoord, nYCoord IF nButton = 1 && Left Mouse IF ABS(nXCoord - THIS.Parent.MouseX) > THIS.Parent.DragThreshold OR ; ABS(nYCoord - THIS.Parent.MouseY) > THIS.Parent.DragThreshold THIS.Drag ENDIF ENDIF ENDPROC PROCEDURE MouseDown LPARAMETERS nButton, nShift, nXCoord, nYCoord THIS.Parent.MouseX = nXCoord THIS.Parent.MouseY = nYCoord ENDPROC PROCEDURE DragDrop LPARAMETERS oSource, nXCoord, nYCoord IF oSource.Name != THIS.Name THIS.Parent.cmdRemove.Click ENDIF ENDPROC PROCEDURE DblClick THIS.Parent.lstSelected.AddItem(This.List(This.ListIndex)) This.RemoveItem(This.ListIndex) ENDPROC PROCEDURE DragOver LPARAMETERS oSource, nXCoord, nYCoord, nState DO CASE CASE nState = 0 && Enter oSource.DragIcon = THIS.Parent.CanDropIcon CASE nState = 1 && Leave oSource.DragIcon = THIS.Parent.NoDropIcon ENDCASE ENDPROC ) *!* Once we hTop = 31 Left = 4 Height = 23 Width = 72 FontBold = .F. FontName = "MS Sans Serif" FontSize = 8 Caption = "\ "U" THEN IF !EMPTY(THISFORM.Controls(nCnt).ControlSource) AND ; TYPE('THISFORM.Controls(nCnt).value') <> "U" THEN *!* Now we need to parse the value property into a proper *!* condition using the parseCondition method of the form cCondition = THIS.Parent.parseCondition(THISFORM.Controls(nCnt).value,THISFORM.Controls(nCnt).controlSource) *!* If there is a condition, add it to are overall filter IF !EMPTY(cCondition) THEN cFilter = cFilter + " AND " + cCondition ENDIF ENDIF ENDIF ENDFOR *!* We need to rollback the transaction to discard the APPEND'ed record ROLLBACK THIS.Enabled = .F. THIS.Parent.cmdQBFMode.Enabled = .T. *!* This removes the " AND " keyword that is not needed for the *!* first condition added to cFilter IF !EMPTY(cFilter) THEN cFilter = ALLTRIM(SUBSTRC(cFilter,5)) ENDIF *!* Now we are ready to apply the filter SET FILTER TO &cFilter THIS.Parent.cmdClearFilter.enabled = .T. GO TOP THISFORM.Refresh ENDPROC  commandbuttoncmdClearFilterPROCEDURE InteractiveChange IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control oForm.ActiveControl.FontBold = THIS.Value CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontBold', THIS.Value, 'TEXTBOX') oForm.SetAll('FontBold', THIS.Value, 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontBold', THIS.Value) ENDCASE ENDPROC BTop = 5 Left = 135 Height = 22 Width = 0 Name = "Separator3"  Separator3 separator separatorjFontName = "MS Sans Serif" FontSize = 8 Height = 22 Left = 5 Top = 5 Width = 125 Name = "cboFonts"  tbrediting.cboFontscombobox UE%o*U Ta H CgCKA lookup table must be specified in the 'lookup_table' property (combo box ).0x T- C$kCOA display column must be specified in the 'display_column' property (combo box ).0x T- CiCMA return column must be specified in the 'return_column' property (combo box ).0x T- %%C 3eTSELECT , FROM  ORDER BY  INTO CURSOR PTSELECT , FROM  INTO CURSOR TT T   U LOKTHIS LOOKUP_TABLENAMEDISPLAY_COLUMN RETURN_COLUMN ORDER_COLUMNNSQL ROWSOURCETYPE ROWSOURCE BOUNDCOLUMNREFRESH H CAn invalid display column or return column has been specified in the 'display_column' or 'return_column' properties (combo box ).0x FkCOAn invalid column has been specified in the 'order_column' property (combo box ).0x  ~CbAn invalid table has been specified in the 'display_column' or 'lookup_table' property (combo box ).0x2CCE0xUNERRORCMETHODNLINETHISNAME8T%C1USE IN &cAlias UCALIASTHISNAMEInit,ErrorDestroy1!q!!A1QAA2! !!A2!A1se%3)  %: UTaUTHIS TMRSWATCHENABLEDT-UTHIS TMRSWATCHENABLED=TTT UTHISNSECNMINNHOUR UPDATEDISPLAYTCCZTCCZTCCZ-TC 06-T C 06-T C 06U CSECDISPLAYTHISNSEC CMINDISPLAYNMIN CHOURDISPLAYNHOUR LBLSECONDSCAPTION LBLMINUTESLBLHOURST%<RTT%<TT -T<UTHISNSECNMINNHOUR UPDATEDISPLAYELAPSEDSECONDS+T:T:UTHIS LBLSEPARATOR1CAPTION LBLSEPARATOR2start,stop^reset updatedisplay increment/Init:1222AAA3qBqABqA3BA1-Hd N nL)) %m!+UB %? ;CUNKEYCODE NSHIFTALTCTRLTHISPARENT SELECTALLy%r@%CC n  U NBUTTONNSHIFTNXCOORDNYCOORDTHISPARENTMOUSEX DRAGTHRESHOLDMOUSEYDRAG<TTUNBUTTONNSHIFTNXCOORDNYCOORDTHISPARENTMOUSEXMOUSEY=%6UOSOURCENXCOORDNYCOORDNAMETHISPARENTCMDADDCLICK6 CCCUTHISPARENT LSTSOURCEADDITEMLIST LISTINDEX REMOVEITEMu H n GT nTU OSOURCENXCOORDNYCOORDNSTATEDRAGICONTHISPARENT CANDROPICON NODROPICONKeyPress, MouseMove MouseDownwDragDropDblClickwDragOver1AA21AA31113qA3131aaA2 "A"A#) lookup_combo  Pixels Class 1 combobox  @r %UTCPXTCC>TC%c BBCCC `UCMCICMD CRETSTRING NRETVALUE MCISENDSTRINGCERRTHIS GETMCIERROR  T%CcErrorbCn%C=*ERROR*jTCC\g%CcErrorbN TTCXCC>TTBCCC `UCERROR LCERRORSTRINGNERROR CERRORSTRINGMCIGETERRORSTRINGTHISMCIERRORMCIERRORSTRINGT%CT%C>C2No filename specified or control source specified!xB(cFileName = ALLTRIM(&cControlSource) %CBT%CTTT9 #T STATUS  READY%C  true!T CLOSE  WAITC  T C T  TQT OPEN "" alias  style child parent CC Z WAITC  %[CxT9BP/T status  window handle waitTCCC  g8TTTT$C(T WINDOW  state showC  5CSET  time format milliseconds %a T9UCCONTROLSOURCETHIS CONTROLSOURCE CFILENAME VIDEOFILECALIASMCIALIASNAME MOUSEPOINTERCCMDDOMCI MAIN_HWNDHWND CUR_WINDOWTHISFORM NULLPOINTERMCIERRORMCIERRORSTRINGHWINX1POSLEFTY1POSTOPX2POSWIDTHY2POSHEIGHT SETWINDOWPOSAUTOPLAY PLAYVIDEOT,TCCSTATUS  lengthg.TCCSTATUS  positiong%+CSEEK  to start WAITCPLAY % %a T dU CALIASTHISMCIALIAS NMEDIALENGTHDOMCINMEDIAPOSITIONMCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODEINTERVALT3%CSTATUS  modeplayingCPAUSE %{ %aTU CALIASTHISMCIALIASDOMCIMCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODEINTERVAL!CCZ: xUTHISMCIERRORMCIERRORSTRING&TSTATUS  READY%Ctrue$TCLOSE  WAITC% %aTU CCMDTHISMCIALIASDOMCIMCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODEINTERVALg4T(%CfSTART CfEND STto TCg%C}B,TCCSTATUS  lengthg% BTto CZ#TSTATUS  READY%Ctrue`TSEEK  CU CPOSITIONCALIASTHISMCIALIASCPOSCMD NPOSITION NMEDIALENGTHDOMCICCMD H%   openvideo m,C Invalid controlSource specified.x2 UNERRORCMETHODNLINE#%a UTHISAUTOOPEN OPENVIDEO*| mciSendString WinMM.DLL,|mciGetErrorString WINMM.DLL+| SetWindowPosUser32U MCISENDSTRINGWINMMDLLMCIGETERRORSTRING SETWINDOWPOSUSER32 UTHIS CLOSEVIDEOdomci, getmcierror openvideoW playvideo1 pausevideo showmcierror closevideo setposition9 Error Refresh Init Destroy1qRAR3qAAAAqR3AAAAAA3ACAAACBS"A3AAA"1A23AA!1AA23cBAA!1AA3qAAAaAAA3A2QA3"A331 m 1M [2fUhtA/J1O^) {{=%"$U H YBR,2The control doesn't support the selected fontsize.8%C$Application.ActiveForm.ActiveControlbOC2fT Error Number: CCZC C Error Message: CEC C  Procedure: CtT C 2x HT i  ~X2BU NERRORCMETHODNLINETHISPARENTREFRESH APPLICATION ACTIVEFORM ACTIVECONTROLLCMSGLNANSWER*&%C_SCREEN.ActiveFormbO5T9AB HR# TCg *CFontSizeCgTEXTBOX*CFontSizeCgEDITBOX # CFontSizeCgU OFORM ACTIVEFORMTHISPARENT NAPPLIESTO ACTIVECONTROLFONTSIZEVALUESETALLError,InteractiveChange-1!!AfAAAAAA3aAAqrrB2#){ t%A\U T%C_SCREEN.ActiveFormbO+C _SCREEN.ActiveForm.ActiveControlbO ~T9TB Ha T ,(CFontNameTEXTBOX (CFontNameEDITBOX  aCFontName C C U OFORMOCONTROL ACTIVEFORM ACTIVECONTROLTHISPARENT NAPPLIESTOFONTNAMEVALUESETALLCBOSIZESFILLLISTREFRESHInteractiveChange,1AAAq1rqBA3-) samples.vcx cbofontnameHnappliesto 1 -- applies to current control -- applies to all controls gCaption = "Editing" Height = 31 Left = 0 Top = 0 Width = 339 nappliesto = 1 Name = "tbrediting"  %  UO%C m.lnScopebN3T %C  >R,4Invalid value passed to conflictmanager.handlerecord# T - T a%C SourceType C (C.T T C /%C bGM.T C _T C  H %   T aT C)A value has been changed by another user.C Field: C Record Number: CCCOZCC m.lcFieldbM}C C Original Value: C  C Current Value: C  C  Your change: CC  &C C   is a Memo field.6C C <Do you want to overwrite the current value with your change?C 0(Choose 'Cancel' to restore the original value.)3 Data Conflictx T C $%      T aT CA value has been changed.C Field:  C Record Number: CCCOZCC m.lcFieldbM}C C Original Value: C  C Current Value: C  C  Your change: CC  &C C   is a Memo field.6C C <Do you want to overwrite the current value with your change?C 0(Choose 'Cancel' to restore the original value.)3Verify Changesx H >   >  % 7T C-aBC 6H BU LNSCOPELNCHOICELNFIELDLCFIELDLUOLDVALLUCURVALLUFIELD LLMADECHANGE LLSUCCESSTHISSTRING T C m.luValueb H. CO BC  C NYwBCC Z D BC * TBC m.luValue LBC .T..F.6 MB Memo fieldULUVALUEUTYPE T -T  H8! CC Buffering%2C| T a! CC Buffering%C T a2 R,:% yET C!Do you want to save your changes?$ Save Changesx% cT CCaa6u Ca B ULNCHOICE LLMADECHANGE LNSUCCESS NOBUFF_LOC1 T  H'! CC Bufferingx%2CtT C! CC Buffering T C+  # *T C  C6T C 2 R,: B U LNSUCCESSLNRECTHIS HANDLERECORD NOBUFF_LOC1 T  H'! CC Bufferingx%2CtT C! CC Buffering T C+  # *T C  C6T C 2 R,: B U LNSUCCESSLLNRECTHIS HANDLERECORD NOBUFF_LOC handlerecord,string verifychangesverifyeachchange checkconflictsA 1AA1A2aAAAA2QVA21AAA1A1AAAA3zAAAQA!1A2 aAAAAQ1AA2aaA!AAAA2aaA!AAAA12WiC{K]r%pJ!)$   7%r!0UB %? ;CUNKEYCODE NSHIFTALTCTRLTHISPARENT SELECTALLy%r@%CC n  U NBUTTONNSHIFTNXCOORDNYCOORDTHISPARENTMOUSEX DRAGTHRESHOLDMOUSEYDRAG<TTUNBUTTONNSHIFTNXCOORDNYCOORDTHISPARENTMOUSEXMOUSEY=%6UOSOURCENXCOORDNYCOORDNAMETHISPARENT CMDREMOVECLICK6 CCCUTHISPARENT LSTSELECTEDADDITEMLIST LISTINDEX REMOVEITEMu H n GT nTU OSOURCENXCOORDNYCOORDNSTATEDRAGICONTHISPARENT CANDROPICON NODROPICONKeyPress, MouseMove MouseDownwDragDropDblClickzDragOver1AA21AA31113qA3131aaA3 "A'F#) Y @@{%U#  C(%Cp TaTTTC T T- % (CCC Z  (CCCC Z U CFONTNAMETHISCLEARASIZES LSCALABLENLEN NLARGESTFONTNSTART NSMALLESTFONTIADDITEMfilllist,1qaAqAAqAA2)@ lookup_combo FontName = "MS Sans Serif" FontSize = 8 Height = 23 Width = 106 display_column = lookup_table = return_column = order_column = Name = "lookup_combo" rint must either be spWPROCEDURE start This.tmrSWatch.enabled = .T. ENDPROC PROCEDURE stop This.tmrSWatch.enabled = .f. ENDPROC PROCEDURE reset This.nSec = 0 This.nMin = 0 This.nHour = 0 This.UpdateDisplay ENDPROC PROCEDURE updatedisplay cSecDisplay = ALLTRIM(STR(This.nSec)) cMinDisplay = ALLTRIM(STR(This.nMin)) cHourDisplay = ALLTRIM(STR(This.nHour)) This.lblSeconds.Caption = IIF(This.nSec < 10, "0" + cSecDisplay , cSecDisplay) This.lblMinutes.Caption = IIF(This.nMin < 10, "0" + cMinDisplay , cMinDisplay) This.lblHours.Caption = IIF(This.nHour < 10, "0" + cHourDisplay , cHourDisplay) ENDPROC PROCEDURE increment THIS.nSec = THIS.nSec + 1 IF THIS.nSec = 60 THIS.nSec = 0 THIS.nMin = THIS.nMin + 1 ENDIF IF THIS.nMin = 60 THIS.nMin = 0 THIS.nHour = THIS.nHour + 1 ENDIF THIS.UpdateDisplay THIS.ElapsedSeconds = (THIS.nHour * 3600) + ; (THIS.nMin * 60) + ; (This.nSec) ENDPROC PROCEDURE Init #DEFINE SEPARATOR_LOC ':' This.lblSeparator1.Caption = SEPARATOR_LOC This.lblSeparator2.Caption = SEPARATOR_LOC ENDPROC   %  UTCPXTCC>TC%c BBCCC `UCMCICMD CRETSTRING NRETVALUE MCISENDSTRINGCERRTHIS GETMCIERROR  T%CcErrorbCn%C=*ERROR*jTCC\g%CcErrorbN TTCXCC>TTBCCC `UCERROR LCERRORSTRINGNERROR CERRORSTRINGMCIGETERRORSTRINGTHISMCIERRORMCIERRORSTRING!CCZ: xUTHISMCIERRORMCIERRORSTRINGg4T(%CfSTART CfEND STto TCg%C}B,TCCSTATUS  lengthg% BTto CZ#TSTATUS  READY%Ctrue`TSEEK  CU CPOSITIONCALIASTHISMCIALIASCPOSCMD NPOSITION NMEDIALENGTHDOMCICCMDb%CmT%Ci4C(No filename or control source specified!xB'cFileName = ALLTRIM(&controlSource) %CBT%CTTT9 #TSTATUS  READY%C true{!TCLOSE  WAITC 1TOPEN "" alias  WAITC % C xT9B5CSET  time format milliseconds % aL T9UTHIS CONTROLSOURCE CFILENAME SOUNDFILECALIASMCIALIASNAME MOUSEPOINTERCCMDDOMCIMCIERRORMCIERRORSTRINGAUTOPLAY PLAYSOUNDT3%CSTATUS  modeplayingCPAUSE %{ %aTU CALIASTHISMCIALIASDOMCIMCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODEINTERVALT,TCCSTATUS  lengthg.TCCSTATUS  positiong%+CSEEK  to start WAITCPLAY % %a T ,U CALIASTHISMCIALIAS NMEDIALENGTHDOMCINMEDIAPOSITIONMCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODEINTERVAL&TSTATUS  READY%Ctrue$TCLOSE  WAITC% %aTU CCMDTHISMCIALIASDOMCIMCIERROR SHOWMCIERROR AUTOREPEAT TMRCHECKMODEINTERVAL H+%   opensound |,C Invalid controlSource specified.x2 UNERRORCMETHODNLINE#%a UTHISAUTOOPEN OPENSOUND*| mciSendString WinMM.DLL,|mciGetErrorString WINMM.DLL+| SetWindowPosUser32U MCISENDSTRINGWINMMDLLMCIGETERRORSTRING SETWINDOWPOSUSER32 UTHIS CLOSESOUNDdomci, getmcierror showmcierrorW setposition opensoundY pausesoundL playsoundZ closesound Error Refresh Init Destroy 1qRAR3qAAAAqR33qAAAaAAA3A2&AAAqAAAA3ACAAS"A33AA!1AA2AAA"AA2cBAA!1AA3QA3"A331 m1x54U SXv cq%}A[y) ttB>%pUTaUTHIS TMRSWATCHENABLEDT-UTHIS TMRSWATCHENABLED=TTT UTHISNSECNMINNHOUR UPDATEDISPLAYTCCZTCCZTCCZ-TC 06-T C 06-T C 06U CSECDISPLAYTHISNSEC CMINDISPLAYNMIN CHOURDISPLAYNHOUR LBLSECONDSCAPTION LBLMINUTESLBLHOURS* T T TUNMINNSECNHOURstart,stop^Reset updatedisplayInit/1222AAA32-Hd N i)tjdisplay_column Specifies the column from lookup_table to display in the drop down list. lookup_table Specifies the table to lookup the values to display in the drop down. return_column Specifies the column value to return the value property of the combo box. order_column Specifies the column to order the records displayed in the drop down list (optional).  cmdQBFMode commandbuttontoolbar7creport Specifies the report to print from this form. tHeight = 136 Width = 342 Desktop = .T. DoCreate = .T. AutoCenter = .T. BorderStyle = 2 Caption = "Print Report" MaxButton = .F. MinButton = .F. WindowType = 1 creport = Name = "print_report" gress.Mismatched pushjmp/popjmp call.Cursoformlsd in, the variables are automatically *!* set to )MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 UTHISFORcomboboxE Init #DEFINE REPORT_NOT_FOUND_LOC "The report m%l {UT%<dTT%<TT 9T<UTHISPARENTNSECNMINNHOUR UPDATEDISPLAYELAPSEDSECONDSTimer,1r1Ar1A2)distinct_values_comboa file name.x * M%R"tUT-UTHISVISIBLE* H# o&%C_SCREEN.ActiveFormbO]T9iB(k+%CTextbox EditboxgT C C  T CCZT CT CT C!2#%CoSourcebOBT  C  T CZT T T UOSOURCETHIS NAPPLIESTOOFORM ACTIVEFORMI CONTROLCOUNTCONTROLS BASECLASSCBOFONTSVALUEFONTNAMECBOSIZESFILLLISTFONTSIZECHKBOLDFONTBOLD CHKITALIC FONTITALIC CHKUNDERLINE FONTUNDERLINEDestroy,RefreshP13qAaAAAAAAAaaaaA1'E) m%l {UT%<dTT%<TT 9T<UTHISPARENTNSECNMINNHOUR UPDATEDISPLAYELAPSEDSECONDSTimer,1r1Ar1A2) PROCEDURE Error LPARAMETERS nError, cMethod, nLine #define NUM_LOC "Error Number: " #define PROG_LOC "Procedure: " #define MSG_LOC "Error Message: " #define CR_LOC CHR(13) #define BADSIZE_LOC "The control doesn't support the selected fontsize." DO CASE CASE nError = 1881 && Fontsize invalid for the control WAIT WINDOW BADSIZE_LOC TIMEOUT 2 IF TYPE("Application.ActiveForm.ActiveControl") = "O" THIS.Parent.Refresh(Application.ActiveForm.ActiveControl) ENDIF OTHERWISE *----------------------------------------------------------- * Display information about an unanticipated error. *----------------------------------------------------------- lcMsg = NUM_LOC + ALLTRIM(STR(nError)) + CR_LOC + CR_LOC + ; MSG_LOC + MESSAGE( )+ CR_LOC + CR_LOC + ; PROG_LOC + PROGRAM(1) lnAnswer = MESSAGEBOX(lcMsg, 2+48+512) DO CASE CASE lnAnswer = 3 &&Abort CANCEL CASE lnAnswer = 4 &&Retry RETRY OTHERWISE RETURN ENDCASE ENDCASE ENDPROC PROCEDURE InteractiveChange IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control oForm.ActiveControl.FontSize = VAL(THIS.Value) CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontSize', VAL(THIS.Value), 'TEXTBOX') oForm.SetAll('FontSize', VAL(THIS.Value), 'EDITBOX') CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontSize', VAL(THIS.Value)) ENDCASE ENDPROC  ttB>%pUTaUTHIS TMRSWATCHENABLEDT-UTHIS TMRSWATCHENABLED=TTT UTHISNSECNMINNHOUR UPDATEDISPLAYTCCZTCCZTCCZ-TC 06-T C 06-T C 06U CSECDISPLAYTHISNSEC CMINDISPLAYNMIN CHOURDISPLAYNHOUR LBLSECONDSCAPTION LBLMINUTESLBLHOURS* T T TUNMINNSECNHOURstart,stop^Reset updatedisplayInit/1222AAA32-Hd N i)t8PROCEDURE InteractiveChange LOCAL oForm, oControl IF TYPE("_SCREEN.ActiveForm") = "O" AND TYPE("_SCREEN.ActiveForm.ActiveControl") = "O" oForm = _SCREEN.ActiveForm oControl = oForm.ActiveControl ELSE RETURN ENDIF DO CASE CASE THIS.Parent.nAppliesTo = 1 && Current Control oControl.FontName = This.Value CASE THIS.Parent.nAppliesTo = 2 && All textboxes and editboxes oForm.SetAll('FontName', This.Value, 'TEXTBOX') oForm.SetAll('FontName', This.Value, 'EDITBOX') *================================================================== * comment out the previous 2 lines and uncomment the following lines * if you want to affect all controls with a baseclass of textbox * or editbox. *------------------------------------------------------------------ *FOR i = 1 to oForm.ControlCount * * IF UPPER(oForm.Controls(i).BaseClass) = 'TEXTBOX' OR ; * UPPER(oForm.Controls(i).BaseClass) = 'EDITBOX' * oForm.Controls(i).FontName = THIS.Value * ENDIF *ENDFOR *================================================================== CASE THIS.Parent.nAppliesTo = 3 && All Controls oForm.SetAll('FontName', This.Value) ENDCASE THIS.Parent.cboSizes.FillList(THIS.Value) THIS.Parent.Refresh(oControl) ENDPROC PROCEDURE Destroy This.Visible = .F. ENDPROC PROCEDURE Refresh LPARAMETERS oSource DO CASE CASE THIS.nAppliesTo = 2 && text and edit boxes IF TYPE("_SCREEN.ActiveForm") = 'O' oForm = _SCREEN.ActiveForm ELSE RETURN ENDIF FOR i = 1 to oForm.ControlCount IF oForm.Controls(i).BaseClass$"Textbox Editbox" THIS.cboFonts.Value = oForm.Controls(i).FontName THIS.cboSizes.FillList(THIS.cboFonts.Value) THIS.cboSizes.Value = STR(oForm.Controls(i).FontSize) THIS.chkBold.Value = oForm.Controls(i).FontBold THIS.chkItalic.Value = oForm.Controls(i).FontItalic THIS.chkUnderline.Value = oForm.Controls(i).FontUnderline EXIT ENDIF ENDFOR OTHERWISE IF TYPE("oSource") != 'O' RETURN ENDIF THIS.cboFonts.Value = oSource.FontName THIS.cboSizes.FillList(THIS.cboFonts.Value) THIS.cboSizes.Value = STR(oSource.FontSize) THIS.chkBold.Value = oSource.FontBold THIS.chkItalic.Value = oSource.FontItalic THIS.chkUnderline.Value = oSource.FontUnderline ENDCASE ENDPROC PROCEDURE Destroy cCursor = "c" + THIS.name IF USED(cCursor) THEN USE IN &cCursor ENDIF ENDPROC PROCEDURE Init #DEFINE NO_TABLE_LOC "The table alias must be specified in the controlSource property, in the format 'alias.column'." IF !EMPTY(THIS.controlSource) THEN IF NOT "." $ THIS.controlSource THEN =MESSAGEBOX(NO_TABLE_LOC) ELSE cAlias = LEFTC(THIS.controlSource,(ATC(".",THIS.controlSource)-1)) cColumn = RIGHTC(THIS.controlSource,(LENC(THIS.controlSource)-ATC(".",THIS.controlSource))) THIS.rowSourceType = 3 cSQL = "SELECT DISTINCT " + cColumn + " FROM " + cAlias + ; " INTO CURSOR c" + THIS.name THIS.rowSource = cSQL ENDIF ENDIF ENDPROC ButtonCount = 3 BackStyle = 0 Value = 1 Height = 110 Left = 10 Top = 14 Width = 242 Name = "opgReportOutput" Option1.FontBold = .F. Option1.FontName = "MS Sans Serif" Option1.FontSize = 8 Option1.BackStyle = 0 Option1.Caption = "Print Preview" Option1.Value = 1 Option1.Height = 15 Option1.Left = 11 Option1.Top = 12 Option1.Width = 80 Option1.AutoSize = .T. Option1.Name = "optPreview" Option2.FontBold = .F. Option2.FontName = "MS Sans Serif" Option2.FontSize = 8 Option2.BackStyle = 0 Option2.Caption = "Printer" Option2.Value = 0 Option2.Height = 15 Option2.Left = 11 Option2.Top = 30 Option2.Width = 48 Option2.AutoSize = .T. Option2.Name = "optPrinter" Option3.FontBold = .F. Option3.FontName = "MS Sans Serif" Option3.FontSize = 8 Option3.BackStyle = 0 Option3.Caption = "File" Option3.Value = 0 Option3.Height = 15 Option3.Left = 11 Option3.Top = 48 Option3.Width = 34 Option3.AutoSize = .T. Option3.Name = "optFile" Row or column position is off the screen.CannPROCEDURE Init #DEFINE NO_LOOKUP_TABLE_LOC "A lookup table must be specified in the 'lookup_table' property (combo box " + THIS.name + ")." #DEFINE NO_DISPLAY_COLUMN_LOC "A display column must be specified in the 'display_column' property (combo box " + THIS.name + ")." #DEFINE NO_RETURN_COLUMN_LOC "A return column must be specified in the 'return_column' property (combo box " + THIS.name + ")." lOK = .T. DO CASE CASE EMPTY(THIS.lookup_table) =MESSAGEBOX(NO_LOOKUP_TABLE_LOC,48) lOK = .F. CASE EMPTY(THIS.display_column) =MESSAGEBOX(NO_DISPLAY_COLUMN_LOC,48) lOK = .F. CASE EMPTY(THIS.return_column) =MESSAGEBOX(NO_RETURN_COLUMN_LOC,48) lOK = .F. ENDCASE IF lOK THEN IF !EMPTY(THIS.order_column) nSQL = "SELECT " + THIS.display_column + "," + THIS.return_column + " FROM " + THIS.lookup_table + " ORDER BY " + THIS.order_column + " INTO CURSOR " + THIS.name ELSE nSQL = "SELECT " + THIS.display_column + "," + THIS.return_column + " FROM " + THIS.lookup_table + " INTO CURSOR " + THIS.name ENDIF THIS.RowSourceType = 3 THIS.RowSource = nSQL THIS.BoundColumn = 2 ENDIF THIS.Refresh ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine #DEFINE INVALID_COLUMN_LOC "An invalid display column or return column has been specified in the 'display_column' or 'return_column' properties (combo box " + THIS.name + ")." #DEFINE INVALID_TABLE_LOC "An invalid table has been specified in the 'display_column' or 'lookup_table' property (combo box " + THIS.name + ")." #DEFINE INVALID_SORT_LOC "An invalid column has been specified in the 'order_column' property (combo box " + THIS.name + ")." DO CASE CASE nError = 1806 =MESSAGEBOX(INVALID_COLUMN_LOC,48) CASE nError = 1808 =MESSAGEBOX(INVALID_SORT_LOC,48) CASE nError = 1802 =MESSAGEBOX(INVALID_TABLE_LOC,48) OTHERWISE =MESSAGEBOX(MESSAGE(),48) ENDCASE ENDPROC PROCEDURE Destroy cAlias = THIS.name IF USED(cAlias) THEN USE IN &cAlias ENDIF ENDPROC Option1.Width = 80 Option1.AutoSize = .T.  M%UZ GUh%C%CINITIALIZE_AND_ADJUSTT-aCADJUSTUTHIS INITIALRESIZELOOPTHROUGHCONTROLSTC&T &T &T &T  ETCCoControl.FontSizebU 6U OCONTROLNLENTHIS ACONTROLSTATSTOPINITIALFORMHEIGHTLEFTINITIALFORMWIDTHHEIGHTWIDTHFONTSIZE "TC"TC"TC$% Textbox Spinner "TCU OCONTROLNPOSTOPTHISFORMHEIGHTTHIS ACONTROLSTATSLEFTWIDTH BASECLASSTCfTCDECIMALv G ( TTa (~TC % pCommandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe Image SpinnerT H'& INITIALIZE_AND_ADJUSTsC C  ADJUSTC '%C  Pageframez& (C v!C C r (n%C  pCommandbutton Combobox Checkbox Listbox Form Grid Textbox Label Shape Editbox Olecontrol Pageframe Image SpinnerjT Hf& INITIALIZE_AND_ADJUST3CC  CC   ADJUSTfCC  T- G (UCTASK NOLDDECIMALNPOSTHISFORM LOCKSCREENI CONTROLCOUNTOCONTROLCONTROLS BASECLASSTHIS ADDTOARRAYSETSIZEJ PAGECOUNTPAGESK)TTUTHISINITIALFORMHEIGHTTHISFORMHEIGHTINITIALFORMWIDTHWIDTH'TaUTHIS INITIALRESIZE ACONTROLSTATSadjustcontrols, addtoarraysetsizeJloopthroughcontrols`Initreset1QaA2qQaaaaQ3!!!A!A;qbqAaQqQAArbaqAAAAAAA2112a1 M &Ah XD  \) iPROCEDURE domci LPARAMETERS cMCIcmd *!* This method takes a MCI command string and executes it using *!* the Windows API function mciSendString *!* If the function executes successfully, the result is returned. *!* Otherwise, the error string is returned. cRetString = space(80) nRetValue = mciSendString(cMCIcmd,@cRetString,len(cRetString),0) cErr = THIS.getMCIerror(nRetValue) IF nRetValue > 0 RETURN CeRR ENDIF RETURN TRIM(STRTRAN(cRetString,chr(0),"")) ENDPROC PROCEDURE getmcierror LPARAMETERS cError LOCAL lcErrorString,nError *!* This method is called from the doMCI to retrieve the last *!* MCI error string. *!* This function also saves the last error number and string *!* into properties associated with the form. nError=0 IF TYPE("cError")="C" IF LEFT(cError,7)="*ERROR*" nError=val(substr(cError,8)) ENDIF ENDIF IF TYPE("cError")="N" nError=cError ENDIF cErrorString=SPACE(256) =mciGetErrorString(nError,@cErrorString,len(cErrorString)) THIS.MCIerror = nError THIS.MCIerrorString = cErrorString RETURN TRIM(CHRTRAN(cErrorString,CHR(0),"")) ENDPROC PROCEDURE openvideo *!* Get needed properties into variables cControlSource = THIS.controlSource IF EMPTY(cControlSource) THEN cFileName = THIS.videoFile IF EMPTY(cFileName) THEN MESSAGEBOX("No filename specified or control source specified!") RETURN ENDIF ELSE cFileName = ALLTRIM(&cControlSource) IF EMPTY(cFileName) THEN RETURN ENDIF ENDIF cAlias = THIS.MCIalias IF EMPTY(cAlias) THEN cAlias = THIS.name THIS.MCIalias = cAlias ENDIF _SCREEN.MousePointer = 11 *!* If video is already loaded, then close it cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + cAlias + " WAIT") THIS.doMCI(cCmd) ENDIF * Returns Handle of Main VFP Window Main_hWnd = _VFP.hWnd * Get Handle of the form with FOXTOOLS.FLL cur_window = THISFORM.HWnd NullPointer = 0 *!* Set up open MCI command into string variable cCmd = ('OPEN "' + cFileName + '" alias ' + cAlias + ; ' style child parent ' + ALLTRIM(STR(cur_window)) + ' WAIT') THIS.doMCI(cCmd) *!* Check to see if MCI command succeeded IF THIS.MCIerror > 0 THEN messagebox(THIS.MCIerrorString) _SCREEN.MousePointer = 0 RETURN ELSE *!* It does have visual media, so we need to set up the window *!* it will play in. *!* Get the window handle of the window playing the video cCmd = "status " + cAlias + " window handle wait" hWin = INT(VAL(THIS.doMCI(cCmd))) *!* Once we have the window handle, we need to position *!* the video window to be the same position and size *!* as our player rectangle on the form x1Pos = THIS.LEFT y1Pos = THIS.TOP x2Pos = x1Pos + THIS.WIDTH y2Pos = y1Pos + THIS.HEIGHT *!* Use the SetWindowPos Windows function to set position and size setWindowPos(hWin,0,x1Pos,y1Pos,x2Pos,y2Pos,0) *!* Everything's done, let's show the video cCmd = ("WINDOW " + cAlias + " state show") THIS.doMCI(cCmd) ENDIF *!* Set the device to use milliseconds when setting/getting position THIS.doMCI("SET " + cAlias + " time format milliseconds") IF THIS.autoPlay = .T. THEN THIS.playVideo ENDIF _SCREEN.MousePointer = 0 ENDPROC PROCEDURE playvideo cAlias = THIS.MCIalias *!* First need to see if the media is at the end *!* by comparing the total length with the current position nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) nMediaPosition = VAL(THIS.doMCI("STATUS " + cAlias + " position")) IF nMediaPosition >= nMediaLength THEN *!* The media is at the end, so we need to seek back to the start *!* of the clip before playing THIS.doMCI("SEEK " + cAlias + " to start WAIT") ENDIF *!* Now we can play the media THIS.doMCI("PLAY " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 100 ENDIF ENDPROC PROCEDURE pausevideo cAlias = THIS.MCIalias *!* Check to see if there is media acutally playing IF THIS.doMCI("STATUS " + cAlias + " mode") = "playing" THEN *!* Yes there is, so execute the PAUSE MCI command THIS.doMCI("PAUSE " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE showmcierror MESSAGEBOX(STR(THIS.MCIerror) + ": " + THIS.MCIerrorString) ENDPROC PROCEDURE closevideo *!* If video is not already closed, then close it cCmd = ("STATUS " + THIS.MCIalias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + THIS.MCIalias + " WAIT") THIS.doMCI(cCmd) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE setposition PARAMETERS cPosition cAlias = THIS.MCIalias IF UPPER(cPosition) = "START" or UPPER(cPosition) = "END" THEN cPosCmd = "to " + cPosition ELSE nPosition = VAL(cPosition) IF EMPTY(nPosition) THEN RETURN ELSE *!* Check to make sure position is not greater than the length nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) IF nMediaLength < nPosition THEN RETURN ELSE cPosCmd = "to " + STR(nPosition) ENDIF ENDIF ENDIF *!* Make sure video is loaded cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN cCmd = "SEEK " + cAlias + " " + cPosCmd THIS.doMCI(cCmd) ENDIF ENDPROC PROCEDURE Error #DEFINE INVALID_CONTROLSOURCE_LOC "Invalid controlSource specified." LPARAMETERS nError, cMethod, nLine DO CASE CASE nError = 12 and cMethod = "openvideo" messageBox(INVALID_CONTROLSOURCE_LOC) OTHERWISE ERROR (nError) ENDCASE ENDPROC PROCEDURE Refresh IF THIS.autoOpen = .T. THEN THIS.openVideo ENDIF ENDPROC PROCEDURE Init *!* This is the primary Windows API function that is used to *!* send MCI commands DECLARE INTEGER mciSendString ; IN WinMM.DLL ; STRING cMCIString,; STRING @cRetString,; INTEGER nRetLength,; INTEGER hInstance *!* This function allows us to retrieve the last MCI error that occured DECLARE INTEGER mciGetErrorString ; IN WINMM.DLL ; INTEGER nErrorno, ; STRING @cBuffer, ; INTEGER nBufSize *!* When MCI plays a video, it creates its own Window. By using *!* this Windows API function we can position this Window to be *!* in the same position as our Player rectangle on the form DECLARE integer SetWindowPos ; IN User32 ; integer, integer, integer, integer, integer, integer, integer ENDPROC PROCEDURE Destroy THIS.closeVideo ENDPROC PROCEDURE domci LPARAMETERS cMCIcmd *!* This method takes a MCI command string and executes it using *!* the Windows API function mciSendString *!* If the function executes successfully, the result is returned. *!* Otherwise, the error string is returned. cRetString = space(80) nRetValue = mciSendString(cMCIcmd,@cRetString,len(cRetString),0) cErr = THIS.getMCIerror(nRetValue) IF nRetValue > 0 RETURN CeRR ENDIF RETURN TRIM(STRTRAN(cRetString,chr(0),"")) ENDPROC PROCEDURE getmcierror LPARAMETERS cError LOCAL lcErrorString,nError *!* This method is called from the doMCI to retrieve the last *!* MCI error string. *!* This function also saves the last error number and string *!* into properties associated with the form. nError=0 IF TYPE("cError")="C" IF LEFT(cError,7)="*ERROR*" nError=val(substr(cError,8)) ENDIF ENDIF IF TYPE("cError")="N" nError=cError ENDIF cErrorString=SPACE(256) =mciGetErrorString(nError,@cErrorString,len(cErrorString)) THIS.MCIerror = nError THIS.MCIerrorString = cErrorString RETURN TRIM(CHRTRAN(cErrorString,CHR(0),"")) ENDPROC PROCEDURE showmcierror MESSAGEBOX(STR(THIS.MCIerror) + ": " + THIS.MCIerrorString) ENDPROC PROCEDURE setposition PARAMETERS cPosition cAlias = THIS.MCIalias IF UPPER(cPosition) = "START" or UPPER(cPosition) = "END" THEN cPosCmd = "to " + cPosition ELSE nPosition = VAL(cPosition) IF EMPTY(nPosition) THEN RETURN ELSE *!* Check to make sure position is not greater than the length nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) IF nMediaLength < nPosition THEN RETURN ELSE cPosCmd = "to " + STR(nPosition) ENDIF ENDIF ENDIF *!* Make sure video is loaded cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN cCmd = "SEEK " + cAlias + " " + cPosCmd THIS.doMCI(cCmd) ENDIF ENDPROC PROCEDURE opensound #DEFINE NO_SOURCE_SPECIFIED_LOC "No filename or control source specified!" *!* Get needed properties into variables IF EMPTY(THIS.controlSource) THEN cFileName = THIS.soundFile IF EMPTY(cFileName) THEN MESSAGEBOX(NO_SOURCE_SPECIFIED_LOC) RETURN ENDIF ELSE cFileName = ALLTRIM(&controlSource) IF EMPTY(cFileName) THEN RETURN ENDIF ENDIF cAlias = THIS.MCIalias IF EMPTY(cAlias) THEN cAlias = THIS.name THIS.MCIalias = cAlias ENDIF _SCREEN.MousePointer = 11 *!* If sound is already loaded, then close it cCmd = ("STATUS " + cAlias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + cAlias + " WAIT") THIS.doMCI(cCmd) ENDIF *!* Set up open MCI command into string variable cCmd = ('OPEN "' + cFileName + '" alias ' + cAlias + ' WAIT') THIS.doMCI(cCmd) *!* Check to see if MCI command succeeded IF THIS.MCIerror > 0 THEN messagebox(THIS.MCIerrorString) _SCREEN.MousePointer = 0 RETURN ENDIF *!* Set the device to use milliseconds when setting/getting position THIS.doMCI("SET " + cAlias + " time format milliseconds") IF THIS.autoPlay = .T. THEN THIS.playSound ENDIF _SCREEN.MousePointer = 0 ENDPROC PROCEDURE pausesound cAlias = THIS.MCIalias *!* Check to see if there is media acutally playing IF THIS.doMCI("STATUS " + cAlias + " mode") = "playing" THEN *!* Yes there is, so execute the PAUSE MCI command THIS.doMCI("PAUSE " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE playsound cAlias = THIS.MCIalias *!* First need to see if the media is at the end *!* by comparing the total length with the current position nMediaLength = VAL(THIS.doMCI("STATUS " + cAlias + " length")) nMediaPosition = VAL(THIS.doMCI("STATUS " + cAlias + " position")) IF nMediaPosition >= nMediaLength THEN *!* The media is at the end, so we need to seek back to the start *!* of the clip before playing THIS.doMCI("SEEK " + cAlias + " to start WAIT") ENDIF *!* Now we can play the media THIS.doMCI("PLAY " + cAlias) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 300 ENDIF ENDPROC PROCEDURE closesound *!* If sound is not already closed, then close it cCmd = ("STATUS " + THIS.MCIalias + " READY") IF THIS.doMCI(cCmd) = "true" THEN *!* If one is, close it cCMD = ("CLOSE " + THIS.MCIalias + " WAIT") THIS.doMCI(cCmd) IF THIS.MCIerror > 0 THEN THIS.showMCIerror ENDIF IF THIS.autoRepeat = .T. THEN THIS.tmrCheckMode.INTERVAL = 0 ENDIF ENDIF ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine #DEFINE INVALID_CONTROLSOURCE_LOC "Invalid controlSource specified." LPARAMETERS nError, cMethod, nLine DO CASE CASE nError = 12 and cMethod = "opensound" messageBox(INVALID_CONTROLSOURCE_LOC) OTHERWISE ERROR (nError) ENDCASE ENDPROC PROCEDURE Refresh IF THIS.autoOpen = .T. THEN THIS.openSound ENDIF ENDPROC PROCEDURE Init *!* This is the primary Windows API function that is used to *!* send MCI commands DECLARE INTEGER mciSendString ; IN WinMM.DLL ; STRING cMCIString,; STRING @cRetString,; INTEGER nRetLength,; INTEGER hInstance *!* This function allows us to retrieve the last MCI error that occured DECLARE INTEGER mciGetErrorString ; IN WINMM.DLL ; INTEGER nErrorno, ; STRING @cBuffer, ; INTEGER nBufSize *!* When MCI plays a video, it creates its own Window. By using *!* this Windows API function we can position this Window to be *!* in the same position as our Player rectangle on the form DECLARE integer SetWindowPos ; IN User32 ; integer, integer, integer, integer, integer, integer, integer ENDPROC PROCEDURE Destroy THIS.closeSound ENDPROC